COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN
C00012 ENDMK
C⊗;
BEGIN


% FOR-LOOP EXPANDING AND OPTIMIZING FUNCTIONS %


EXPR ?&FOR1 (L, FN, EX, BE, LISTS);	% THE BASIC WORKHORSE; RETURNS (PROG ...) %
	'PROG CONS
	?&PROGVARS(L, LISTS, FN, EX) CONS
	?&INITS(1, L, LISTS, ?&RPLACA(FN, EX)) @
	'LOOP CONS
	?&TEST(L, ?&TEST1(L, LISTS, 1), FN, EX) CONS
	?&SETS(L, LISTS) @
	?&NEXTS(L, LISTS, 1) @
	?&VAL(FN, EX) @
	(IF BE THEN <<'COND, <BE, ?&RET(FN, EX)>>>) @
	'(GO LOOP) CONS
	IF LENGTH ?&NEWVARS(L) ≠ LENGTH L THEN
		'EXIT CONS ?&RESETS(L, LISTS, 1, CDR L) @ <?&RET(FN, EX)>;


EXPR ?&PROGVARS (L, LISTS, FN, EX);
	(IF ?&RPLACA(FN, EX) THEN '(?&V ?&VV) ELSE '(?&V))
		@ LISTS
		@ ?&RNGES(L, 1)
		@ ?&NEWVARS(L)
		@ IF EX AND NOT(FN EQ 'PROG2 OR FN EQ 'APPEND) THEN
			'(?&NOTFIRST ?&EX);


EXPR ?&RNGES (L, N);
	IF NULL L THEN NIL
	ELSE (IF ?&HOW(L) EQ '?← THEN
		(IF NUMBERP ?&UPPER(L) THEN NIL ELSE <AT("&UPPER" CAT N)>)
		@ (IF NUMBERP ?&INCR(L) THEN NIL
		   ELSE <AT("&INC" CAT N), AT("&POS" CAT N),
			 AT("&NEG" CAT N), AT("&ZERO" CAT N)>))
		@ ?&RNGES(CDR L, N+1);


EXPR ?&NEWVARS (L);
	IF NULL L THEN NIL ELSE
	IF ?&NEW(L) EQ 'NEW THEN ?&VAR(L) CONS ?&NEWVARS(CDR L)
	ELSE ?&NEWVARS(CDR L);


EXPR ?&INITS (N, L, LISTS, R);
	IF NULL L THEN
		IF R THEN '((SETQ ?&V (SETQ ?&VV (LIST NIL))))
		ELSE NIL
	ELSE (	IF ?&HOW(L) EQ '?← THEN ?&INITS1(L, CAR LISTS, N)
		ELSE <<'SETQ, CAR LISTS, ?&LIST(L)>>)
	    @ ?&INITS(N+1, CDR L, CDR LISTS, R);


EXPR ?&INITS1 (L, LST, N);
	<'SETQ, LST, ?&LOWER(L)>
		CONS (	IF NUMBERP ?&UPPER(L) THEN NIL
			ELSE <<'SETQ, AT("&UPPER" CAT N), ?&UPPER(L)>>)
		@ (IF NUMBERP ?&INCR(L) THEN NIL ELSE
			<<'SETQ, AT("&INC" CAT N), ?&INCR(L)>, 
			 <'COND, <<'IGREATERP, AT("&INC" CAT N), 0>,
				  <'SETQ, AT("&POS" CAT N), T>>
			       , <<'ILESSP, AT("&INC" CAT N), 0>,
				  <'SETQ, AT("&NEG" CAT N), T>>
			       , <T, <'SETQ, AT("&ZERO" CAT N), T>> >>);


EXPR ?&TEST (L, TESTS, FN, EX);
	<'COND, <IF CDR TESTS THEN 'OR CONS TESTS ELSE CAR TESTS, 
		 IF LENGTH ?&NEWVARS(L) = LENGTH L THEN ?&RET(FN, EX)
		 ELSE '(GO EXIT)>>;


EXPR ?&TEST1 (L, LISTS, N);
	IF NULL L THEN NIL
	ELSE ?&TEST2(L, CAR LISTS, N) @ ?&TEST1(CDR L, CDR LISTS, N+1);


EXPR ?&TEST2 (L, LST, N);
	IF ?&HOW(L) EQ '?← THEN
		?&TEST3(?&INCR(L), ?&NUM(?&UPPER(L), "&UPPER", N), LST, N)
	ELSE <<'NULL, LST>>;


EXPR ?&TEST3 (INC, UP, LST, N);
	IF NUMBERP INC THEN
		<<IF INC IGREATERP 0 THEN 'IGREATERP ELSE 'ILESSP, LST, UP>>
	ELSE <<'AND, AT("&POS" CAT N), <'IGREATERP, LST, UP>>,
	      <'AND, AT("&NEG" CAT N), <'ILESSP, LST, UP>>, AT("&ZERO" CAT N)>;


EXPR ?&SETS (L, LISTS);
	IF NULL L THEN NIL
	ELSE <'SETQ, ?&VAR(L),
		IF ?&HOW(L) EQ 'IN THEN <'CAR, CAR LISTS> ELSE CAR LISTS>
	    CONS ?&SETS(CDR L, CDR LISTS);


EXPR ?&NEXTS (L, LISTS, N);
	IF NULL L THEN NIL
	ELSE <'SETQ, CAR LISTS,
		IF ?&HOW(L) EQ '?← THEN ?&NEXTS1(?&INCR(L), CAR LISTS, N)
		ELSE <'CDR,CAR LISTS>>
	    CONS ?&NEXTS(CDR L, CDR LISTS, N+1);


EXPR ?&NEXTS1 (INC, LST, N);
	IF INC =  1 THEN <'ADD1, LST> ELSE
	IF INC = -1 THEN <'SUB1, LST>
	ELSE <'PLUS, LST, ?&NUM(INC, "&INC", N)>;


EXPR ?&VAL (FN, EX);
	IF NULL EX THEN NIL
	ELSE IF FN EQ 'PROG2 THEN <<'SETQ, '?&V, EX>>
	ELSE IF ?&RPLACA(FN, EX) THEN <<'NCONC, '?&VV, <'SETQ, '?&VV, EX>>>
	ELSE IF FN EQ 'APPEND THEN <<'SETQ, '?&V, <'APPEND, '?&V, EX>>>
	ELSE <<'SETQ, '?&EX, EX>, 
	      <'SETQ, '?&V, <'COND, <'?&NOTFIRST, <FN, '?&V, '?&EX>>,
			'((SETQ ?&NOTFIRST T) ?&EX)>>>;


EXPR ?&RESETS (L, LISTS, N, MANY);
	IF NULL L THEN NIL
	ELSE (IF ?&NEW(L) EQ 'OLD THEN
			?&RESETS1(?&TEST2(L, CAR LISTS, N), L, MANY))
		@ ?&RESETS(CDR L, CDR LISTS, N+1, MANY);


EXPR ?&RESETS1 (TT, L, MANY);
	IF MANY THEN
		<<'AND, IF CDR TT THEN 'OR CONS TT ELSE CAR TT,
			<'SETQ, ?&VAR(L), NIL>>>
	ELSE <<'SETQ, ?&VAR(L), NIL>>;


EXPR ?&RET (FN, EX);
	IF ?&RPLACA(FN, EX) THEN '(RETURN (CDR ?&V)) ELSE '(RETURN ?&V);


EXPR ?&LISTLST (L, N);
	IF NULL L THEN NIL
	ELSE AT("&L" CAT N) CONS ?&LISTLST(CDR L, N+1);


EXPR ?&NUM (V, X, N);
	IF NUMBERP V THEN V ELSE AT(X CAT N);


EXPR ?&RPLACA (FN, EX);
	FN EQ 'APPEND AND NOT ATOM EX AND EX[1] EQ 'LIST;


EXPR ?&NEW (L);		L[1,1];		% {NEW, OLD} %
EXPR ?&VAR (L);		L[1,2];		% CONTROL VARIABLE %
EXPR ?&HOW (L);		L[1,3];		% {IN, ON, ←} %
EXPR ?&LIST (L);	L[1,4];		% LIST TO BE STEPPED THROUGH %
EXPR ?&LOWER (L);	L[1,4,2];	% LOWER LIMIT FOR NUMERICAL FOR LOOPS %
EXPR ?&UPPER (L);	L[1,4,3];	% UPPER LIMIT FOR NUMERICAL FOR-LOOPS %
EXPR ?&INCR (L);	L[1,4,4];	% INCREMENT FOR NUMERICAL FOR-LOOPS %


EXPR ?&LOOP1 (NAME, FN, EX, BE);	% EXPANDS DO-UNTIL, COLLECT-UNTIL, WHILE-DO. WHILE-COLLECT %
	IF ?&RPLACA(FN, EX) THEN
		'(PROG (?&V ?&VV) (SETQ ?&V (SETQ ?&VV (LIST NIL))) LOOP)
		@	IF NAME EQ '?&DO THEN
				<<'NCONC, '?&VV, <'SETQ, '?&VV, EX>>,
				 <'COND, <BE, '(RETURN (CDR ?&V))>,
					 '(T (GO LOOP))>>
			ELSE	<<'COND, <BE, <'NCONC, '?&VV, <'SETQ, '?&VV, EX>>>,
					 '(T (RETURN (CDR ?&V)))>,
				 '(GO LOOP)>
	ELSE IF (IF FN EQ 'APPEND THEN EX ← <'APPEND, '?&V, EX> ELSE EX) THEN
		'(PROG (?&V) LOOP)
		@	IF NAME EQ '?&DO THEN
				<<'SETQ, '?&V, EX>,
				 <'COND, <BE, '(RETURN ?&V)>, '(T (GO LOOP))>>
			ELSE	<<'COND, <BE, <'SETQ, '?&V, EX>>,
					 '(T (RETURN ?&V))>,
				 '(GO LOOP)>
	ELSE	'(PROG NIL LOOP)
		@	IF NAME EQ '?&DO THEN
				<<'COND, <<'NOT, BE>, '(GO LOOP)>>>
			ELSE	<<'COND, <BE, '(GO LOOP)>>>;


EXPR ?&CARS (X, L, N);			% EXPANDS AND OPTIMIZES INDEX EXPRESSIONS %
	IF NULL L THEN X ELSE
	IF NUMBERP CAR L THEN
		IF N ≤ 3 THEN
			?&CARS(<AT("C" CAT SUBSTR("ADDD",
					IF CAR L + N ≤ 4 THEN 1 ELSE 2,
					IF CAR L + N ≤ 4 THEN CAR L ELSE 4-N)
					CAT SUBSTR(CAR X, 2, 'ALL)), CADR X>,
				IF CAR L + N ≤ 4 THEN CDR L
				ELSE CAR L + N - 4 CONS CDR L,
				CAR L + N)
		ELSE IF CAR L ≤ 4 THEN
			?&CARS(<AT("C" CAT SUBSTR("ADDD", 1, CAR L) CAT "R"), X>,
				CDR L, CAR L)
		ELSE ?&CARS(<'CDDDDR, X>, (CAR L - 4) CONS CDR L, 4)
	ELSE ?&CARS(<'CAR, <'SUFLIST, X,
			IF NOT ATOM CAR(L) AND CAAR L EQ 'ADD1 THEN CADAR L
			ELSE <'SUB1, CAR L>>>,
		CDR L, 1);


END.